home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / FCONV.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  3.6 KB  |  167 lines
  1. /*
  2.  * fconv.r -- abs, cset, integer, numeric, proc, real, string.
  3.  */
  4.  
  5. "abs(N) - produces the absolute value of N."
  6.  
  7. function{1} abs(n)
  8.    /*
  9.     * If n is convertible to a small integer or real, this code returns
  10.     * -n if n is negative -- not valid in all cases.  (Should return a
  11.     * LargeInt in that case?)
  12.     */
  13.    if cnv:(exact)C_integer(n) then {
  14.       abstract {
  15.          return integer
  16.          }
  17.       inline {
  18.          return C_integer Abs(n);
  19.          }
  20.       }
  21. #ifdef LargeInts
  22.    else if cnv:(exact)integer(n) then {
  23.       abstract {
  24.          return integer
  25.          }
  26.       inline {
  27.          cpbignum(&n,&result);
  28.      BlkLoc(result)->bignumblk.sign = 0;
  29.          return result;
  30.          }
  31.       }
  32. #endif                    /* LargeInts */
  33.    else if cnv:C_double(n) then {
  34.       abstract {
  35.          return real
  36.          }
  37.       inline {
  38.          return C_double Abs(n);
  39.          }
  40.       }
  41.    else
  42.       runerr(102,n)
  43. end
  44.  
  45.  
  46. /*
  47.  * The convertible types cset, integer, real, and string are identical
  48.  *  enough to be expansions of a single macro, parameterized by type.
  49.  */
  50. #begdef ReturnYourselfAs(t)
  51. #t "(x) - produces a value of type " #t " resulting from the conversion of x, "
  52.    "but fails if the conversion is not possible."
  53. function{0,1} t(x)
  54.  
  55.    if cnv:t(x) then {
  56.       abstract {
  57.          return t
  58.          }
  59.       inline {
  60.          return x;
  61.          }
  62.       }
  63.    else {
  64.       abstract {
  65.          return empty_type
  66.          }
  67.       inline {
  68.          fail;
  69.          }
  70.       }
  71. end
  72.  
  73. #enddef
  74.  
  75. ReturnYourselfAs(cset)     /* cset(x) - convert to cset or fail */
  76. ReturnYourselfAs(integer)  /* integer(x) - convert to integer or fail */
  77. ReturnYourselfAs(real)     /* real(x) - convert to real or fail */
  78. ReturnYourselfAs(string)   /* string(x) - convert to string or fail */
  79.  
  80.  
  81. "numeric(x) - produces an integer or real number resulting from the "
  82. "type conversion of x, but fails if the conversion is not possible."
  83.  
  84. function{0,1} numeric(n)
  85.  
  86.    if cnv:(exact)integer(n) then {
  87.       abstract {
  88.          return integer
  89.          }
  90.       inline {
  91.          return n;
  92.          }
  93.       }
  94.    else if cnv:real(n) then {
  95.       abstract {
  96.          return real
  97.          }
  98.       inline {
  99.          return n;
  100.          }
  101.       }
  102.    else {
  103.       abstract {
  104.          return empty_type
  105.          }
  106.       inline {
  107.          fail;
  108.          }
  109.       }
  110. end
  111.  
  112.  
  113. "proc(x,i) - convert x to a procedure if possible; use i to resolve "
  114. "ambiguous string names."
  115.  
  116. function{0,1} proc(x,i)
  117.  
  118.    if is:procedure(x) then {
  119.       abstract {
  120.          return procedure
  121.          }
  122.       inline {
  123.          return x;
  124.          }
  125.       }
  126.  
  127.    else if cnv:tmp_string(x) then {
  128.       /*
  129.        * i must be 1, 2, or 3; it defaults to 1.
  130.        */
  131.       if !def:C_integer(i, 1) then
  132.          runerr(101, i)
  133.       inline {
  134.          if (i < 1 || i > 3) {
  135.             irunerr(205, i);
  136.             errorfail;
  137.             }
  138.          }   
  139.  
  140.       abstract {
  141.          return procedure
  142.          }
  143.       inline {
  144.          struct b_proc *proc;
  145.  
  146.          /*
  147.           * Attempt to convert Arg0 to a procedure descriptor using i to
  148.           *  discriminate between procedures with the same names.  Fail if
  149.           *  the conversion isn't successful.
  150.           */
  151.          proc = strprc(&x, i);
  152.          if (proc == NULL)
  153.             fail;
  154.          else
  155.             return procedure(proc);
  156.          }
  157.       }
  158.    else {
  159.       abstract {
  160.          return empty_type
  161.          }
  162.       inline {
  163.          fail;
  164.          }
  165.       }
  166. end
  167.